home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 05 Programming / DYNAM.FTH < prev    next >
Text File  |  2019-04-13  |  5KB  |  331 lines
  1. file: dynam.fth
  2.  
  3. scr #0 
  4.  0>      dynamic memory management
  5.  1> 
  6.  2> 
  7.  3> 
  8.  4> 
  9.  5> 
  10.  6>              by
  11.  7>    bruce o'neel copyright 1986
  12.  8> 
  13.  9>  created 9/6/86
  14. 10>  modified 9/6/86
  15. 11> 
  16. 12> 
  17. 13> 
  18. 14> 
  19. 15> 
  20.  
  21.  
  22.  
  23. file: dynam.fth
  24.  
  25. scr #1 
  26.  0> // dynamic memory directory screen
  27.  1> 3 load  // load dynamic memory
  28.  2> 
  29.  3> 
  30.  4> 
  31.  5> 
  32.  6> 
  33.  7> 
  34.  8> 
  35.  9> 
  36. 10> 
  37. 11> 
  38. 12> 
  39. 13> 
  40. 14> 
  41. 15> 
  42.  
  43.  
  44.  
  45. file: dynam.fth
  46.  
  47. scr #2 
  48.  0> 
  49.  1> 
  50.  2> 
  51.  3> 
  52.  4> 
  53.  5> 
  54.  6> 
  55.  7> 
  56.  8> 
  57.  9> 
  58. 10> 
  59. 11> 
  60. 12> 
  61. 13> 
  62. 14> 
  63. 15> 
  64.  
  65.  
  66.  
  67. file: dynam.fth
  68.  
  69. scr #3 
  70.  0> // dynamic memory load screen
  71.  1> 1 fh 11 fh thru
  72.  2> 
  73.  3> 
  74.  4> 
  75.  5> 
  76.  6> 
  77.  7> 
  78.  8> 
  79.  9> 
  80. 10> 
  81. 11> 
  82. 12> 
  83. 13> 
  84. 14> 
  85. 15> 
  86.  
  87.  
  88.  
  89. file: dynam.fth
  90.  
  91. scr #4 
  92.  0>    // dynam.  constants and storage allocation
  93.  1> 4 constant headersize  // size in bytes for two addresses
  94.  2> 1000 constant dynam-size // size in bytes of dynamic memory
  95.  3> 
  96.  4> variable begin-dynam  // starting pointer variable
  97.  5> 
  98.  6> create bom    dynam-size allot
  99.  7> here constant tom
  100.  8> 
  101.  9> 
  102. 10> 
  103. 11> 
  104. 12> 
  105. 13> 
  106. 14> 
  107. 15> 
  108.  
  109.  
  110.  
  111. file: dynam.fth
  112.  
  113. scr #5 
  114.  0>    // dynam. ^next ^size init-dynam
  115.  1> 
  116.  2> : ^next ; // <n---m> takes n, pointer to dynam area
  117.  3>           // returns m, pointer to next dynam area pointer
  118.  4> 
  119.  5> : ^size 2+ ; // <n---m> same as ^next but to size address
  120.  6> 
  121.  7> 
  122.  8> : init-dynam  // inits dynamic memory
  123.  9>     bom ^next off   // no next block
  124. 10>     tom bom 4 + - // size of free area
  125. 11>     bom ^size !  // save it
  126. 12>     bom begin-dynam ! ;  // store start pointer
  127. 13> 
  128. 14> init-dynam
  129. 15> 
  130.  
  131.  
  132.  
  133. file: dynam.fth
  134.  
  135. scr #6 
  136.  0>    // dynam. smallest-block ?split-block
  137.  1> 
  138.  2> 20 constant smallest-block // smallest block, make larger
  139.  3>    // if memory becomes too fragmented,
  140.  4>    // make smaller if memory runs out too easily
  141.  5> 
  142.  6> : ?split-block   // <a,n---f> true if a can be split
  143.  7>      swap ^size @   // get size
  144.  8>      smallest-block - // subtract smallest block size
  145.  9>      headersize - // subtrace out header size
  146. 10>      < ;  // compare them
  147. 11> 
  148. 12> 
  149. 13> : <=  // <n1,n2---f> true if n1 <= n2
  150. 14>     2dup < >r = r> or ;
  151. 15> 
  152.  
  153.  
  154.  
  155. file: dynam.fth
  156.  
  157. scr #7 
  158.  0>    // dynam.  split-block
  159.  1> : split-block // <a1,n---a2> split block a2 of size n off of a1
  160.  2>     2dup swap
  161.  3>     ^size @
  162.  4>     headersize -  // subtract out header
  163.  5>     swap - >r over r@
  164.  6>     swap ^size !  // store new size
  165.  7>     swap r> +  // add current size
  166.  8>     headersize +  // add in header length
  167.  9>     dup >r
  168. 10>     ^size !  // store size of a2
  169. 11>     r> ; // next pointer is left indeterminate
  170. 12> 
  171. 13> 
  172. 14> 
  173. 15> 
  174.  
  175.  
  176.  
  177. file: dynam.fth
  178.  
  179. scr #8 
  180.  0>    // dynam.  find-good-block
  181.  1> : find-good-block  // <n---a> steps along chain to find block
  182.  2>    // a which will hold n bytes
  183.  3>   begin-dynam @
  184.  4>   begin
  185.  5>      swap over
  186.  6>      ^size @   // get this blocks size
  187.  7>      <=        // is it good enough?
  188.  8>      if exit then  // if so, exit
  189.  9>      ^next @ dup 0=   // test end condition
  190. 10>   until
  191. 11>   true abort" dynamic memory allocation error" ;  // error exit
  192. 12> 
  193. 13> 
  194. 14> 
  195. 15> 
  196.  
  197.  
  198.  
  199. file: dynam.fth
  200.  
  201. scr #9 
  202.  0>    // dynam.  calloc  memory allocation
  203.  1> : calloc  // <n---a> returns pointer to block of size n
  204.  2>    dup find-good-block // find one at least large enough
  205.  3>    swap 2dup
  206.  4>    ?split-block   // can it be split?
  207.  5>    if
  208.  6>       split-block  // if so, split it
  209.  7>    else
  210.  8>       drop
  211.  9>    then dup begin-dynam @ =
  212. 10>    abort" dynamic memory full"
  213. 11>    headersize + ; // point to beginning of block
  214. 12>       // not beginning of header
  215. 13> 
  216. 14> 
  217. 15> 
  218.  
  219.  
  220.  
  221. file: dynam.fth
  222.  
  223. scr #10 
  224.  0>    // dynam.  ?between
  225.  1> : ?between  // <n1,n2,n3---> true if n1 is between n2 and n3
  226.  2>     >r over < swap r> < and ;
  227.  3> 
  228.  4> 
  229.  5> 
  230.  6> 
  231.  7> 
  232.  8> 
  233.  9> 
  234. 10> 
  235. 11> 
  236. 12> 
  237. 13> 
  238. 14> 
  239. 15> 
  240.  
  241.  
  242.  
  243. file: dynam.fth
  244.  
  245. scr #11 
  246.  0>    // dynam. find-between
  247.  1> : find-between  // <a1---a2> finds a2 to link with a1
  248.  2>     begin-dynam @
  249.  3>     begin
  250.  4>        2dup
  251.  5>        dup ^next @
  252.  6>        dup 0= if
  253.  7>           2drop drop swap drop exit
  254.  8>        then
  255.  9>        ?between if
  256. 10>           swap drop exit
  257. 11>        then
  258. 12>     again ;
  259. 13> 
  260. 14> 
  261. 15> 
  262.  
  263.  
  264.  
  265. file: dynam.fth
  266.  
  267. scr #12 
  268.  0>    // dynam.  ?merge-dynam  merge-dynam
  269.  1> : ?merge-dynam  // <a1,a2---f> true if a1 can be merged with a2
  270.  2>      dup 0= if 2drop false exit then  // exit if a2 is 0
  271.  3>      swap over ^size @ headersize + rot + = ;
  272.  4> 
  273.  5> 
  274.  6> : merge-dynam  // <a1,a2---> merge a1 with a2
  275.  7>     swap ^size @ headersize +
  276.  8>     swap ^size  +! ;
  277.  9> 
  278. 10> 
  279. 11> 
  280. 12> 
  281. 13> 
  282. 14> 
  283. 15> 
  284.  
  285.  
  286.  
  287. file: dynam.fth
  288.  
  289. scr #13 
  290.  0>    // dynam.  link-in
  291.  1> : link-in  // <a1,a2---> link a2 into chain at a1
  292.  2>     swap >r        // save a2
  293.  3>     dup  ^next @ // forward link from a1
  294.  4>     r@ ^next !   // link a2 forward
  295.  5>     r> swap  ^next ! ; // link a1 forward to a2
  296.  6> 
  297.  7> 
  298.  8> 
  299.  9> 
  300. 10> 
  301. 11> 
  302. 12> 
  303. 13> 
  304. 14> 
  305. 15> 
  306.  
  307.  
  308.  
  309. file: dynam.fth
  310.  
  311. scr #14 
  312.  0>    // dynam. cfree
  313.  1> : cfree  // <a---> free up block pointed to by a
  314.  2>     headersize -   // get back to my pointers
  315.  3>     dup find-between  // find where it goes
  316.  4>     2dup ?merge-dynam if
  317.  5>          2dup merge-dynam
  318.  6>          swap drop dup ^next @ swap 2dup
  319.  7>          ?merge-dynam if 2dup swap ^next @ swap !
  320.  8>          merge-dynam else 2drop then
  321.  9>     else 2dup ^next @ ?merge-dynam if
  322. 10>          merge-dynam
  323. 11>     else link-in then then ;
  324. 12> 
  325. 13> 
  326. 14> 
  327. 15> 
  328.  
  329.  
  330.  
  331.